Liberías

library(readr)
library(kableExtra)
library(dplyr)

Pregunta 1

Complete las demostraciones de los Teoremas 2 y 4 de la presentación de la clase.

Pregunta 2

Diseñe un algoritmo en pseudocódigo para el Método del Análisis Discriminante Lineal según la teoría vista en clase.

// Entrada:
// - X: Matriz de datos de tamaño n por m

// Salida:
// - G: matriz de centros de gravedad de cada clase
// - u: Los factores discriminates
// - lambda : valores propios

//Funcion ADL(X)

// Paso 1: Separar los datos en dos bases
X1 = datos con m_1 variables númericas
X2 = código disyuntivo completo de las modalidades de la variable catégorica

// Paso 2: Calcular la matriz diagonal de cantidad de individuos en cada clase
D_G <- diag(n_g)

// Paso 3: Calcular la matriz de centros de gravedades
G = (D_G)^-1*(X2)^t*X1

// Paso 4: Calcular la matriz de la cual se obtienen los factores discriminantes
// y valores propios asociados
FD_matriz <- (X1^t*X1)^-1*G^t*D_G*G

// Paso 5: Obtener los vectores y valores propios de FD_matriz
u <- eigen(FD_matriz)$vectors
lambda <- eigen(FD_matriz)$values

// Devolver matriz de centros de gravedad de cada clase,los factores discriminates
// y valores propios
devolver G, u, lambda

//Fin Funcion

// Uso del modelo para clasificación:

//  Funcion ADL(X)
// Proyectar los nuevos datos
proyeccion = w^T * X_nuevo

// Determinar la clase basada en la cercanía a las medias proyectadas
Si abs(proyeccion - m0) < abs(proyeccion - m1) entonces
    devolver 0
Sino
    devolver 1

Pregunta 4

Con las definiciones anteriores pruebe lo siguiente: Si V;VB;VW son las matrices de covarianza total, inter-clase intra-clase, respectivamente, entonces:

1. V = VB + VW

2. \(\sum_{s=1}^rq_sg_s = 0\). Es decir, \(rang(C_g) \leq r-1\)

3. \(rang(C_g) = rang(V_B)\)

Además, para la tabla de datos Ejemplo AD.csv calcule: gA, gB, gC, V, VB, VW y verifique que V = VB + VW

Primeramente, se carga la base de datos

Ejemplo_AD <-read.csv("Ejemplo_AD.csv",sep = ";",dec='.',header=T,row.names = 1,stringsAsFactors = T)

Las columnas de variables númericas deben estar centradas, por lo que, la media de cada una debe ser cero. Verifiquemos si lo están:

colMeans(Ejemplo_AD[,-6])

##       RT1       RT2       RT3       RT4       RT5 
##  7.213333  5.746667  1.950000  0.710000 21.740000

Se puede observar que las medias de cada columna númerica son diferente de cero, por lo que, debemos centrarlos de la siguiente manera:

for(i in 1: (ncol(Ejemplo_AD)-1)) {
  Ejemplo_AD[,i] <- Ejemplo_AD[,i]-mean(Ejemplo_AD[,i])
}

head(Ejemplo_AD)

##           RT1        RT2   RT3   RT4   RT5 VC
## A1  1.7866667 -1.1466667  0.05 -0.61  4.06  A
## B1 -3.2133333 -2.4466667 -1.55 -0.11 10.66  B
## C1 -5.8133333 -4.7466667 -0.85 -0.21  1.76  C
## A2  2.7866667  0.9533333  1.95 -0.51 -6.04  A
## B2  0.9866667  0.4533333  0.15 -0.51 -4.74  B
## C2 -4.7133333 -0.3466667 -1.15 -0.31 -5.44  C

Se obtienen los dos juegos de datos con las que se trabajan, la primera con variables númericas y la segunda con el código disyuntivo completo de las modalidades de la variable categórica.

X <- data.matrix(Ejemplo_AD)

# Datos con las variables númericas
X1<- X[,-6]
head(X1)

##           RT1        RT2   RT3   RT4   RT5
## A1  1.7866667 -1.1466667  0.05 -0.61  4.06
## B1 -3.2133333 -2.4466667 -1.55 -0.11 10.66
## C1 -5.8133333 -4.7466667 -0.85 -0.21  1.76
## A2  2.7866667  0.9533333  1.95 -0.51 -6.04
## B2  0.9866667  0.4533333  0.15 -0.51 -4.74
## C2 -4.7133333 -0.3466667 -1.15 -0.31 -5.44

El segundo juego de datos es:

# Datos con las variables categóricas
VC.A <- as.numeric(Ejemplo_AD$VC == "A")
VC.B <- as.numeric(Ejemplo_AD$VC == "B")
VC.C <- as.numeric(Ejemplo_AD$VC == "C")

X2 <- cbind(VC.A,VC.B,VC.C)
head(X2)

##      VC.A VC.B VC.C
## [1,]    1    0    0
## [2,]    0    1    0
## [3,]    0    0    1
## [4,]    1    0    0
## [5,]    0    1    0
## [6,]    0    0    1

Luego, se calcula matriz \(D_g\) diagonal del número de individuos en cada modalidad.

D_G <- table(Ejemplo_AD$VC,Ejemplo_AD$VC)
D_G

##    
##      A  B  C
##   A 10  0  0
##   B  0 10  0
##   C  0  0 10

Ahora, se obtienen los centros de gravedad de A, B y C.

\(g_A\)

# Matriz cuyas filas son los centros de gravedad
G <- solve(D_G) %*% t(X2) %*% X1

gA <- G[1,]
gA

##        RT1        RT2        RT3        RT4        RT5 
##  3.6866667  0.8433333  1.3400000 -0.3500000 -0.4000000

\(g_B\)

gB <- G[2,]
gB

##         RT1         RT2         RT3         RT4         RT5 
## -0.51333333  0.09333333 -0.21000000  0.25000000  0.48000000

\(g_C\)

gC <- G[3,]
gC

##        RT1        RT2        RT3        RT4        RT5 
## -3.1733333 -0.9366667 -1.1300000  0.1000000 -0.0800000

Seguido, se procede a calcular la matriz de covarianzas total \(V\).

# Matriz de pesos del conjuntos de individuos de la matriz X1
peso <-1/nrow(X1)
pesos_ind <- diag(peso, nrow(X1))

V <- t(X1)%*%pesos_ind %*%X1
kable_styling(kable(V))

La matriz de covarianzas inter-clase \(V_B\) es:

# Matriz diagonal de pesos de las 3 clases
pesos_clases <- D_G*peso

VB <- t(G)%*%pesos_clases%*%G
kable_styling(kable(VB))

La matriz de covarianzas intra-clase \(V_W\) es:

clases <- unique(Ejemplo_AD$VC)

# Se calcula la matriz VW
VW <- matrix(0, nrow = 5, ncol = 5)

for(i in (1:length(clases))) {
  clase <- Ejemplo_AD[Ejemplo_AD$VC == clases[i], -6]
  n <- nrow(clase)

  # Calcular la suma para la clase actual
  suma <- matrix(0, nrow = 5, ncol = 5)
  for(j in 1: n){
    xi_minus_g <- as.numeric(clase[j,] - G[i,])
    suma <- suma + xi_minus_g%*%t(xi_minus_g)
  }
  VW <- VW + suma
}
VW <- peso*VW
kable_styling(kable(VW))

Verificamos que se cumple \(V = V_B+V_W\).

kable_styling(kable(VB+VW))

Se puede notar que la suma de esas matrices es igual a \(V\).